home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / error_hn / mcbundle / vbprftrc.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-16  |  4.4 KB  |  130 lines
  1. Option Explicit
  2.  
  3. Declare Function cGetWindowsDirectory Lib "vbprftrc.dll" () As String
  4. Declare Function cKillFileAll Lib "vbprftrc.dll" (ByVal lpFilename As String) As Integer
  5. Declare Function cTimerClose Lib "vbprftrc.dll" (ByVal TimerHandle As Integer) As Integer
  6. Declare Function cTimerOpen Lib "vbprftrc.dll" () As Integer
  7. Declare Function cTimerRead Lib "vbprftrc.dll" (ByVal TimerHandle As Integer) As Long
  8. Declare Function cTimerStart Lib "vbprftrc.dll" (ByVal TimerHandle As Integer) As Integer
  9.  
  10. 'Don't change any variables and their value below
  11.  
  12. Type tagTRACERtype
  13.    StartStop                        As String * 1
  14.    RoutineHandle                    As Integer
  15. End Type
  16.  
  17. Type tagPROFILERtype
  18.    ModuleName                       As String * 12
  19.    RoutineHandle                    As String * 4
  20.    RoutineName                      As String * 82
  21.    TimeCounter                      As Integer
  22.    TotalCall                        As Long
  23.    TotalTime                        As Long
  24.    MinimumTime                      As Long
  25.    MaximumTime                      As Long
  26.    Dummy                            As String * 10
  27.    CrLf                             As String * 2
  28. End Type
  29.  
  30. Dim tagTRACER                       As tagTRACERtype
  31. Dim tagPROFILER                     As tagPROFILERtype
  32.  
  33. Dim TotalRoutines                   As Integer
  34. Dim ActualTrace                     As Long
  35. Dim OldStartRoutine                 As Integer
  36. Dim OldStopRoutine                  As Integer
  37.  
  38. Dim FileTR                          As String
  39. Dim FilePF                          As String
  40.  
  41. Dim chanFileTR                      As Integer
  42. Dim chanFilePF                      As Integer
  43.  
  44. Sub mcStartTracer (RoutineNumber As Integer)
  45.  
  46.    Dim TimerCounter  As Integer
  47.    Dim Status        As Integer
  48.    
  49.    ' check if the routine number is not outside the limits
  50.    If ((RoutineNumber < 1) Or (RoutineNumber > TotalRoutines)) Then Exit Sub
  51.       
  52.    ' check if this is the same routine
  53.    If (OldStartRoutine <> RoutineNumber) Then
  54.       ' increment the trace number
  55.       ActualTrace = ActualTrace + 1
  56.       ' prepare the trace information
  57.       tagTRACER.StartStop = ">"
  58.       tagTRACER.RoutineHandle = RoutineNumber
  59.       ' save the trace information
  60.       Put #chanFileTR, ActualTrace, tagTRACER
  61.    End If
  62.  
  63.    ' save the old routine
  64.    OldStartRoutine = RoutineNumber
  65.  
  66.    ' read the record associated with the routine number
  67.    Get #chanFilePF, RoutineNumber, tagPROFILER
  68.  
  69.    ' open a timer
  70.    TimerCounter = cTimerOpen()
  71.    ' save the handle of the new timer
  72.    tagPROFILER.TimeCounter = TimerCounter
  73.    ' increment the number of calls
  74.    tagPROFILER.TotalCall = tagPROFILER.TotalCall + 1
  75.  
  76.    ' save the record associated with the routine number
  77.    Put #chanFilePF, RoutineNumber, tagPROFILER
  78.  
  79.    ' start the timer
  80.    Status = cTimerStart(TimerCounter)
  81.    
  82. End Sub
  83.  
  84. Sub mcStopTracer (RoutineNumber As Integer)
  85.  
  86.    Dim TimerCounter  As Integer
  87.    Dim TimeElapsed   As Long
  88.    Dim Status        As Integer
  89.    
  90.    ' check if the routine number is not outside the limits
  91.    If ((RoutineNumber < 1) Or (RoutineNumber > TotalRoutines)) Then Exit Sub
  92.  
  93.    ' check if this is the same routine
  94.    If (OldStopRoutine <> RoutineNumber) Then
  95.       ' increment the trace number
  96.       ActualTrace = ActualTrace + 1
  97.       ' prepare the trace information
  98.       tagTRACER.StartStop = "<"
  99.       tagTRACER.RoutineHandle = RoutineNumber
  100.       ' save the trace information
  101.       Put #chanFileTR, ActualTrace, tagTRACER
  102.    End If
  103.  
  104.    ' save the old routine
  105.    OldStopRoutine = RoutineNumber
  106.  
  107.    ' read the record associated with the routine number
  108.    Get #chanFilePF, RoutineNumber, tagPROFILER
  109.  
  110.    ' check if the timer is valid
  111.    If (tagPROFILER.TimeCounter > 0) Then
  112.       ' computes the elapsed time
  113.       TimeElapsed = cTimerRead(tagPROFILER.TimeCounter)
  114.       ' add the elapsed time
  115.       tagPROFILER.TotalTime = tagPROFILER.TotalTime + TimeElapsed
  116.       ' check for the minimum time
  117.       If (TimeElapsed < tagPROFILER.MinimumTime) Then tagPROFILER.MinimumTime = TimeElapsed
  118.       ' check for the minimum time
  119.       If (TimeElapsed > tagPROFILER.MaximumTime) Then tagPROFILER.MaximumTime = TimeElapsed
  120.    End If
  121.  
  122.    ' save the record associated with the routine number
  123.    Put #chanFilePF, RoutineNumber, tagPROFILER
  124.  
  125.    ' close the associated timer
  126.    Status = cTimerClose(tagPROFILER.TimeCounter)
  127.  
  128. End Sub
  129.  
  130.